home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 2 / Tech Arsenal 2 (Arsenal Computer).iso / clipper / s93bsp.exe / S87 / INV01.PRG < prev    next >
Encoding:
Text File  |  1988-05-19  |  2.3 KB  |  100 lines
  1. *       Printing an invoice
  2. procedure INVOUT
  3. parameters PINVNO
  4. private PC, PT, DOIT
  5. PC = chr(18)+chr(15)
  6. PT = chr(27)+":"
  7. DOIT = .t.
  8.  
  9. if QBPROMPT("Printer Loaded and Online|Quit|")<>1
  10.     return
  11. endif
  12. if PINVNO=0
  13.     do QBMESS with "Serious program error - how the hell did we get here?",colflash,15
  14. endif
  15.  
  16. do while DOIT
  17.     select PARTLINE
  18.     go top
  19.     NLOOPS = max(int(ceiling(reccount()/33)),1)
  20.  
  21.     select INVOICE
  22.     do QBPRCTL with "P"
  23.     if GETOUT
  24.         return
  25.     endif
  26.     for I=1 to NLOOPS
  27.         do QBTXTMAC with "IVFORMAT.TXT"
  28.         if NLOOPS>I
  29.             if QBYESNO("More to do - Ready with next Sheet?")="N"
  30.                 exit
  31.             endif
  32.         endif
  33.     next
  34.     do QBPRCTL with "R:Invoice printed"
  35.     DOIT = (QBYESNO("Print this Invoice again?")="Y")
  36. enddo
  37. return
  38.  
  39. ******************************************************************
  40.  
  41. procedure QBTXTMAC
  42. *       uses clipper file reading facilities and
  43. *       Tom Rettig function atnext()
  44.  
  45. PARAMETERS fname
  46. PUBLIC partplen
  47. PRIVATE buffer, occ, opos, npos, macline
  48. partplen = 61
  49. set alternate to invtrace.txt
  50. set alternate on
  51. if file(fname)
  52.     buffer = memoread(fname)
  53. else
  54.     do QBMESS with "Format file for Invoice missing",COLFLASH,10
  55.     return
  56. endif
  57.  
  58. store 1 to occ, opos, npos
  59. DO WHILE .T.
  60.     npos = atnext(chr(13),buffer,occ)
  61.     IF npos=0
  62.         EXIT
  63.     ENDIF
  64.     macline = substr(buffer,opos,npos-opos)
  65.     do case
  66.     case substr(macline,1,1)="*"
  67.         set print off
  68.         do QBMESS with substr(macline,2),COLHEAD,0
  69.         set print on
  70.     case substr(macline,1,1)="?"
  71.         macline = substr(macline,2)
  72.         ?? &macline
  73.     otherwise
  74.         ? &macline
  75.     endcase
  76.     opos = npos + 2
  77.     occ = occ + 1
  78. ENDDO
  79.  
  80. set alternate off
  81. set alternate to
  82. RETURN
  83.  
  84. ******************************************************************
  85.  
  86. function PRPART
  87. *  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 99  9999.99   9999.99
  88. private PSTR
  89. PSTR = ""  && chr(18)+chr(15)                      && Set compressed
  90. select PARTLINE
  91. if eof()
  92.     PSTR = space(PARTPLEN)
  93. else
  94.     PSTR = PSTR+PARTDESC+str(QTY,2)+space(1)+str(UPRICE,7,2)+space(4)+str(TPRICE,7,2)
  95.     PARTPLEN = len(PSTR)
  96.     skip
  97. endif
  98. select INVOICE
  99. return PSTR && +chr(27)+":"            && and set 12CPI
  100.